home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
FILEUTIL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
10KB
|
357 lines
UNIT FileUtil;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Misc. file utilities Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, Dos,
NetFile;
PROCEDURE ReadLine(VAR f: File; VAR s: String);
FUNCTION ChangeDir(Dir: PathStr): Boolean;
PROCEDURE RunCmd(CONST Cmd, SubDir: String);
FUNCTION UniqueName(FName: PathStr): PathStr;
PROCEDURE TruncateFile(CONST FileName: PathStr);
FUNCTION DeleteFile(CONST FileName: PathStr): Boolean;
FUNCTION MakeTaskFileName(CONST InFile: PathStr): PathStr;
PROCEDURE CloseFiles(Exit: Boolean);
PROCEDURE OpenFiles(OpenLog: Boolean);
PROCEDURE MakeFullDir(Dir: PathStr);
FUNCTION ChkDir(CONST s: PathStr): Boolean;
FUNCTION RenameFile(CONST OldName, NewName : PathStr) : Boolean;
FUNCTION FileCRC(CONST FName: PathStr): LongInt;
FUNCTION DriveSize(d: byte): LongInt; { -1 not found, 1GB >= 1 Giga }
FUNCTION DriveFree(d: byte): LongInt; { -1 not found, 1GB >= 1 Giga }
FUNCTION CopyFile(CONST f1, f2: PathStr; Touch, MoveIt: Boolean): Integer;
IMPLEMENTATION
USES OpCrt, OpWindow, OpDos, OpString,
PoPTypes, LogFile, InterCom, Resource, OproUtil, DosShell, Crc,
Globals, Util, StrUtil, Display;
PROCEDURE ReadLine(VAR f: File; VAR s: String);
VAR
OldPos : LongInt;
Buf : Array[0..254] Of Char;
Test : Word;
i : Byte;
BEGIN
S:='';
OldPos:=FilePos(f);
BlockRead(f, Buf, SizeOf(Buf), Test);
i:=0;
WHILE (Test<>0) And (i<Test) AND (Buf[i]<>#10) DO
BEGIN
IF (Buf[i]<>#10) AND (Buf[i]<>#13) THEN S:=S+Buf[i];
Inc(i);
END;
Seek(f, OldPos+i+1);
IF IoResult<>0 THEN ;
END;
FUNCTION ChangeDir(Dir: PathStr): Boolean;
BEGIN
Dir:=ReplaceEnv(Dir);
IF (Length(Dir)>3) AND (Dir[Length(Dir)]='\') THEN Dec(Dir[0]) ELSE
IF (Length(Dir)=2) THEN Dir:=Dir+'\';
ChDir(Dir);
ChangeDir:=(IOResult=0);
END;
FUNCTION FileCRC(CONST FName: PathStr): LongInt;
VAR
f : FILE;
c : LongInt;
buf : Pointer;
i, BufSize, Test : Word;
Gauge : PGauge;
BEGIN
c:=$FFFFFFFF;
Assign(f,FName); FileMode:=ShareRead+ShareDenyW; Reset(f,1);
IF IOResult=0 THEN
BEGIN
New(Gauge, Init((ScreenHeight DIV 2)-2, 2, 'Calculating CRC on: '+JustFileName(FName), FileSize(f)));
BufSize:=8192 {Max64k(MaxAvail-1024)};
GetMem(Buf,BufSize);
IF (Gauge<>NIL) AND (Buf<>NIL) THEN
BEGIN
WHILE NOT EoF(f) DO
BEGIN
BlockRead(f, buf^, BufSize, Test);
FOR i:=1 TO Test DO
c:=UpdCRC32(BT(Buf^)[i],c);
Gauge^.Update(FilePos(f));
END;
END ELSE
AddLog('!', 'Not enough memory to calculate CRC on: '+FName);
IF Buf<>NIL THEN FreeMem(Buf,BufSize);
IF Gauge<>NIL THEN Dispose(Gauge, Done);
Close(f);
END;
FileCRC:=NOT c;
END;
PROCEDURE RunCmd(CONST Cmd, SubDir: String);
VAR
SaveDir : PathStr;
Tmp : WindowPtr;
i : Integer;
BEGIN
AddLog(' ','Running: '+Cmd);
GetDir(0,SaveDir);
ChangeDir(SubDir);
MyWin(Tmp,1,1,80,ScreenHeight,0,'',False);
Writeln('Running: ',Cmd);
IF Cfg.SwapOnExec THEN
BEGIN
i:=ShellToDos(GetEnv('COMSPEC'),'/C '+Cmd,False);
END ELSE
BEGIN
i:=ExecDos(Cmd,True,NoExecDosProc);
END;
IF i<>0 THEN AddLog('!','Error '+Long2Str(i)+' running: '+Cmd);
KillWindow(Tmp);
ChangeDir(SaveDir);
END;
FUNCTION UniqueName(FName: PathStr): PathStr;
VAR
n : Byte;
BEGIN
n := 1;
WHILE ExistFile(FName) DO
BEGIN
FName:=Copy(FName, 1, Length(FName)-Length(Long2Str(n)))+Long2Str(n);
Inc(n);
END;
UniqueName:=FName;
END;
PROCEDURE TruncateFile(CONST FileName: PathStr);
VAR
Dummy : FILE;
BEGIN
Assign(Dummy, FileName);
Rewrite(Dummy);
IF IoResult = 0 THEN Close(Dummy);
END;
FUNCTION DeleteFile(CONST FileName: PathStr) : Boolean;
VAR
Dummy : FILE;
BEGIN
Assign(Dummy, FileName);
Erase(Dummy);
DeleteFile:=(IoResult=0);
END;
PROCEDURE CloseFiles(Exit: Boolean);
BEGIN
ClosePortalLog(Exit);
CloseInterCom;
CloseResLib;
END;
FUNCTION ChkDir(CONST s: PathStr): Boolean;
VAR
g : PathStr;
BEGIN
GetDir(0, g);
ChkDir:=ChangeDir(s);
ChDir(g);
END;
FUNCTION MakeTaskFileName(CONST InFile: PathStr): PathStr;
VAR
FileName, Path : PathStr;
Ext : String[4];
BEGIN
IF Cfg.TaskNumber=0 THEN
MakeTaskFileName:=InFile
ELSE
BEGIN
FileName:=JustFileName(InFile);
Path:=JustPathName(InFile);
IF Length(Path)>0 THEN Path:=Path+'\';
Ext:=Copy(FileName,Pos('.',FileName),Length(FileName)-Pos('.',FileName)+1);
FileName:=Copy(FileName,1,Pos('.',FileName)-1);
IF Length(FileName)>6 THEN FileName:=Copy(FileName,1,6);
IF Cfg.HexTask THEN
FileName:=FileName+HexB(Cfg.TaskNumber)
ELSE
FileName:=FileName+LongIntForm('@@', Cfg.TaskNumber);
MakeTaskFileName:=Path+FileName+Ext;
END;
END;
PROCEDURE MakeFullDir(Dir: PathStr);
VAR
a : Byte;
BEGIN
Dir:=AddBackSlash(Dir);
FOR a:=2 TO Length(Dir) DO
IF Dir[a]='\' THEN
BEGIN
MkDir(Copy(Dir,1,a-1));
IF IOResult=0 THEN ;
END;
END;
FUNCTION RenameFile(CONST OldName, NewName : PathStr) : Boolean;
VAR
f : FILE;
BEGIN
Assign(f, OldName);
Rename(f, NewName);
RenameFile := (IoResult = 0);
END;
PROCEDURE OpenFiles(OpenLog: Boolean);
BEGIN
IF OpenLog THEN OpenPortalLog;
OpenResLib(StartPath+PoPResourceFileName);
IF Not OpenInterCom(Cfg.TaskNumber,cfg.Addresses[Cfg.MainAdrNum]) THEN Halt(250);
END;
{$IFDEF OS2}
Function DriveSize(d:byte): Longint;
BEGIN
DriveSize:=DiskSize(d);
END;
Function DriveFree(d:byte): Longint;
BEGIN
DriveFree:=DiskFree(d);
END;
{$ELSE}
Function DriveSize(d:byte):Longint; { -1 not found, 1=>1 Giga }
VAR
R : Registers;
Begin
With R Do
Begin
ah:=$36;
dl:=d;
Intr($21,R);
If AX=$FFFF Then
DriveSize:=-1 { Drive not found }
Else
If (DX=$FFFF) or (Longint(ax)*cx*dx=1073725440) Then
DriveSize:=1073725440
Else
DriveSize:=Longint(ax)*cx*dx;
End;
End;
Function DriveFree(d:byte):Longint;
VAR
R : Registers;
Begin
With R Do
Begin
ah:=$36;
dl:=d;
Intr($21, R);
If AX=$FFFF Then
DriveFree:=-1 { Drive not found }
Else
If (BX=$FFFF) or (Longint(ax)*bx*cx=1073725440) Then
DriveFree:=1073725440
Else
DriveFree:=Longint(ax)*bx*cx;
End;
END;
{$ENDIF}
FUNCTION CopyFile(CONST f1,f2 : PathStr; Touch,MoveIt: Boolean): Integer;
LABEL
EndCopy;
VAR
ind,ud : FILE;
Sr : SearchRec;
num,res,bufsiz : Word;
fsize,time, dfree : LongInt;
buf : Pointer;
FileWin,DiskWin : PGauge;
io : Integer;
BEGIN
IF MoveIt AND (StUpCase(f1[1])=StUpCase(f2[1])) THEN
BEGIN
DeleteFile(f2);
IF RenameFile(f1,f2) THEN Io:=0 ELSE Io:=5;
END ELSE
BEGIN
IF MaxAvail>65521+2048 THEN bufsiz:=65521 ELSE bufsiz:=MaxAvail-2048;
GetMem(buf,bufsiz);
Assign(ind,f1); FileMode:=ShareRead+ShareDenyW;
Reset(ind,1);
fsize:=FileSize(ind);
dfree:=DriveFree(ORD(UpCase(f2[1]))-64);
New(FileWin,Init(8,3,'Copying file '+JustFileName(f1),fsize));
New(DiskWin,Init(12,3,'Free space on drive '+f2[1],DriveSize(Ord(UpCase(f2[1]))-64)));
IF fsize+2048>dfree THEN
BEGIN
IF dfree=-1 THEN
BEGIN
FindFirst(f2,AnyFile,sr);
io:=DosError;
FindClose(sr);
END ELSE
io:=5;
GOTO EndCopy;
END;
Assign(ud,f2);
Rewrite(ud,1);
io:=IoResult;
IF io=0 THEN
BEGIN
WHILE NOT EOF(ind) DO
BEGIN
IF FileWin<>NIL THEN FileWin^.Update(FileSize(ud));
DiskWin^.Update(DriveFree(Ord(f2[1])-64));
BlockRead(ind,buf^,bufsiz,num);
io:=IoResult;
IF io<>0 THEN
BEGIN
io:=3;
GOTO EndCopy;
END ELSE
BEGIN
BlockWrite(ud,buf^,num,res);
io:=IoResult;
IF (io<>0) OR (num<>res) THEN
BEGIN
io:=4;
GOTO EndCopy;
END;
END;
END;
IF FileWin<>NIL THEN FileWin^.Update(FileSize(ud));
DiskWin^.Update(DriveFree(Ord(f2[1])-64));
GETFTIME(ind,Time);
IF Not Touch THEN SetFTime(ud,Time);
Close(ud);
END;
EndCopy:
Close(ind);
IF (Io=0) AND MoveIt THEN DeleteFile(f1);
FreeMem(buf,bufsiz);
Dispose(DiskWin,Done);
IF FileWin<>NIL THEN Dispose(FileWin,Done);
END;
CopyFile:=Io;
END;
END.